Crack It!/Crack It!.iso/CONTENT/DISKEDIT/DIR.PAS

Pascal/Delphi Source File | 1996-09-10 | 9KB | 328 lines

{
  ***

  DIR.PAS - an object-oriented file selection facility
  (C)Copyright Gerard Paul Java 1996

}

unit Dir;

interface
uses Dos;

type
  FileNameStr = string[13];

  DirListType = ^DirEntry;
  DirEntry = record
               Name: FileNameStr;
               Prev,Next: DirListType;
             end;

  DirObject = object
                DirName: DirStr;
                Mask: FileNameStr;
                DirList: DirListType;
                DirError: boolean;
                procedure Init;
                procedure ReadIn(PathName: PathStr);
                procedure Select(X,Y: byte;
                                 var FileName: FileNameStr;var Signal: boolean);
                procedure Sort(ListToSort: DirListType);
                procedure Clear;
              end;

implementation
uses Crt,ScreenRt,SysRt,MenuRt,Error;

procedure DirObject.Init;
begin
  DirList := nil;
  DirError := False;
end;

procedure DirObject.ReadIn;
var
  tNode: DirListType;
  LastNode: DirListType;
  sRec: SearchRec;
  FileName: NameStr;
  FileExt: ExtStr;

  Dirs: DirListType;
  LastDir: DirListType;

begin
  Dirs := nil;

  FSplit(PathName,DirName,FileName,FileExt);

  Mask := FileName+FileExt;

  { first build a list of all subdirectories }

  FindFirst(DirName+'*.*',Directory,sRec);
  while DosError = 0 do
    begin
      if ((sRec.Attr and Directory) <> 0) and (sRec.Name <> '.')then
        begin
          New(tNode);
          tNode^.Name := sRec.Name+'\';

          if Dirs = nil then
            begin
              tNode^.Prev := nil;
              Dirs := tNode;
            end
          else
            begin
              tNode^.Prev := LastDir;
              LastDir^.Next := tNode;
            end;

          LastDir := tNode;
          tNode^.Next := nil;
        end;
      FindNext(sRec);
    end;

  FindFirst(PathName,Archive+ReadOnly,sRec);

  while DosError = 0 do
    begin
      New(tNode);

      tNode^.Name := sRec.Name;

      if DirList = nil then
        begin
          tNode^.Prev := nil;
          DirList := tNode;
        end
      else
        begin
          LastNode^.Next := tNode;
          tNode^.Prev := LastNode;
        end;

      LastNode := tNode;
      tNode^.Next := nil;

      FindNext(sRec);
    end;

  if (DosError <> 0) and (DosError <> 18) then
    DirError := True;

  Sort(DirList);
  Sort(Dirs);

  if Dirs <> nil then
    begin
      LastDir^.Next := DirList;
      DirList^.Prev := LastDir;
      DirList := Dirs;
    end;

end;

procedure DirObject.Select;
var
  tNode,ScrollNode: DirListType;
  Row: byte;
  Keystroke: char;
  TerminateLoop: boolean;
  Ctr: byte;

begin
  if DirError then
    begin
      ErrBox('Unable to read directory','Press a key to continue',Instruct);
      WaitForKeyPress;
      Signal := True;
    end
  else if DirList = nil then
    begin
      ErrBox('No files found','Press a key to continue',Instruct);
      WaitForKeyPress;
      Signal := True;
    end
  else
    begin
      tNode := DirList;
      Row := 1;

      TextAttr := BoxAttr;
      DrawBox(X,Y,X+17,Y+10,DoubleLine);Window(X+1,Y+1,X+16,Y+9);

      Row := 0;
      TextAttr := OptionNormTextAttr;

      repeat
        Inc(Row);
        GotoXY(1,Row);Write(' ',tNode^.Name);
        tNode := tNode^.Next;
      until (Row = 9) or (tNode = nil);

      tNode := DirList;

      Row := 1;
      TerminateLoop := False;

      repeat
        GotoXY(1,Row);TextAttr := OptionSelectedTextAttr;
        Write(' ',tNode^.Name);ClrEol;
        Keystroke := ReadKey;
        GotoXY(1,Row);TextAttr := OptionNormTextAttr;Write(' ',tNode^.Name);ClrEol;

        case Keystroke of
          ExtKey: case ReadKey of
                    UpKey: begin
                             if tNode^.Prev <> nil then
                               begin
                                 if Row = 1 then
                                   begin
                                     GotoXY(2,1);InsLine;
                                     Write(tNode^.Prev^.Name);
                                   end
                                 else
                                   Dec(Row);

                                 tNode := tNode^.Prev;
                               end;
                           end;
                    DownKey: begin
                               if tNode^.Next <> nil then
                                 begin
                                   if Row = 9 then
                                     begin
                                       GotoXY(1,1);DelLine;
                                       GotoXY(2,9);Write(tNode^.Next^.Name);
                                     end
                                   else
                                     Inc(Row);

                                   tNode := tNode^.Next;
                                 end;
                             end;
                    PgDnKey: begin
                               ScrollNode := tNode;

                               { move pointer to end of displayed list }
                               if Row < 9 then
                                 begin
                                   for Ctr := Row+1 to 9 do
                                     begin
                                       ScrollNode := ScrollNode^.Next;
                                     end;
                                 end;

                               if ScrollNode^.Next <> nil then
                                 begin
                                   Ctr := 1;
                                   while (Ctr <= 9) and (ScrollNode^.Next <> nil) do
                                     begin
                                       GotoXY(1,1);DelLine;
                                       GotoXY(2,9);Write(ScrollNode^.Next^.Name);
                                       tNode := tNode^.Next;
                                       ScrollNode := ScrollNode^.Next;
                                       Inc(Ctr);
                                     end;
                                 end;
                             end;
                    PgUpKey: begin
                               ScrollNode := tNode;

                               { move pointer top of displayed list }
                               if Row > 1 then
                                 begin
                                   for Ctr := Row-1 downto 1 do
                                     begin
                                       ScrollNode := ScrollNode^.Prev;
                                     end;
                                 end;

                               if ScrollNode^.Prev <> nil then
                                 begin
                                   Ctr := 1;
                                   while (Ctr <= 9) and (ScrollNode^.Prev <> nil) do
                                     begin
                                       GotoXY(1,1);InsLine;
                                       GotoXY(2,1);Write(ScrollNode^.Prev^.Name);
                                       tNode := tNode^.Prev;
                                       ScrollNode := ScrollNode^.Prev;
                                       Inc(Ctr);
                                     end;
                                 end;
                             end;


                  end;
           Enter: begin
                    TerminateLoop := True;
                    Signal := False;
                  end;
           Esc: begin
                  TerminateLoop := True;
                  Signal := True;
                end;
        end;
      until TerminateLoop;

      FileName := tNode^.Name;
    end;
end;

procedure DirObject.Sort;
var
  tNode1,tNode2: DirListType;
  tName: FileNameStr;

begin
  tNode1 := ListToSort;

  while tNode1 <> nil do
    begin
      tNode2 := tNode1^.Next;
      while tNode2 <> nil do
        begin
          if tNode1^.Name > tNode2^.Name then
            begin
              tName := tNode1^.Name;
              tNode1^.Name := tNode2^.Name;
              tNode2^.Name := tName;
            end;

          tNode2 := tNode2^.Next;
        end;

      tNode1 := tNode1^.Next;
    end;
end;

procedure DirObject.Clear;
var
  tNode1: DirListType;
  tNode2: DirListType;

begin
  if DirList <> nil then
    begin
      tNode1 := DirList;
      tNode2 := DirList^.Next;

      repeat
        Dispose(tNode1);
        tNode1 := tNode2;

        if tNode2 <> nil then
          tNode2 := tNode2^.Next;
      until tNode1 = nil
    end;
end;



end.